perm filename LOOP.FAI[NEW,LCS]22 blob
sn#393302 filedate 1978-11-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE LOOP SUBROUTINE LOOP(I,J,L,M,N)
C00046 ENDMK
C⊗;
TITLE LOOP ; SUBROUTINE LOOP(I,J,L,M,N)
ENTRY LOOP,FINDIT,PLACE,DPYNEW,MVBEAM,MVBX,JUGGLE,XNOTE,BAUTO,RNX,RCURVE
ENTRY SORT2,UPDATE,NEWR,MSSLUP,LUP2,HOMER,CODN,FSCAN,NALF,BOX,PARCH
ENTRY RJED,RJED2,EDX,EQUAL,BOXX
EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL,SCM,RNW,YED
EXTERNAL SC,SCX,RRJJ,STF,ALF,POSI,RMOD,RINP,SIZ,HOMX,LIMIT,IDEV
EXTERNAL RHORZ,SETCUR,DPYSET,DPYBRT,SETPOG,ALINE,DPTR,ALOG,JCHAR
MM←1 ↔ NN←2 ↔ JK←3 ↔JT←4 ↔IEND←5 ↔A←6 ↔K←7↔ IS←10↔ IZ←11↔ R←12↔ L←13
RC←14 ↔ NX←15 ;**** AC'S 0,1,2,3,5 ARE USED IN 'PLACE' & 'FINDIT'!!
; DIMENSION N(1)
LOOP: 0 ; DO 1 NN=I+L,J+L,K
MOVE 1,@4(16)
SUB 1,@3(16) ; MM IS IN 1
MOVE 2,@(16)
ADD 2,@3(16) ;I+L -- NN, 1ST TIME
MOVE 3,@1(16)
ADD 3,@3(16) ;J+L
HRRZI 5,@5(16) ; ADR. OF N
ADDI 2,-1(5) ; N(NN)
ADDI 3,-1(5)
MOVE 4,@2(16) ;K
JUMPL 4,LP3 ; JUMP IF NEG. INCR.
HRRM 1,.+1 ; ADD IN MM
LP1: MOVE 6,(2)
MOVEM 6,(2) ;N(NN)=N(NN+MM)
CAIGE 2,(3)
AOJA 2,LP1
JRA 16,6(16)
LP3: HRRM 1,.+1
LP2: MOVE 6,(2) ;NEG. INCR.
MOVEM 6,(2)
CAILE 2,(3)
SOJA 2,LP2
JRA 16,6(16) ; END
PLACE: 0 ; FUNCTION PLACE(X)
; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
; EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
MOVN 2,@(16) ; PLACE=R11-ABS(RD-X)
FADR 2,RMOD+=9 ;END
MOVMS 2
MOVE 0,.COMM.+=12 ;R11
FSBR 0,2
JRA 16,1(16)
FINDIT: 0 ; FUNCTION FINDIT(N)
SETZ ; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
HRRZ 1,@(16) ; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
;; HRRZI 2,PTR ; FINDIT=0
;; ADDI 1,(2) ; L=PWDS(N)
;; MOVE 2,-1(1) ; IF(RN(L+1).NE.1)GO TO 377
;; FIXX(2) ; IF(RN(L+2).EQ.R2)RETURN
;; HRRZI 3,XRN ;377 FINDIT=-1
;; ADDI 3,(2) ; END
MOVE 2,PTR-1(1) ;THESE 3 REPLACE ABOVE
MOVE 5,XRN(2)
CAME 5,[1.0]
JRST FNEG
MOVEM 2,LIMIT+2 ; SENDS BACK A NUM IN L
MOVE 5,XRN+1(2)
CAME 5,.COMM.
FNEG: SETO
JRA 16,1(16)
DPYNEW: 0 ; SUBROUTINE DPYNEW
JSA 16,ACCPOG ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
JUMP [1] ; CALL ACCPOG(1)
MOVE 2,DPY+=4001 ; IF(IGO.GT.0)RETURN
JUMPG 2,DB ; CALL DPYOUT(1)
JSA 16,DPYOUT ; END
JUMP [1]
DB: JRA 16,(16)
MVBEAM: 0 ;C THESE MOVE ENDS OF PARTIAL INNER BEAMS.
HRRZ 2,(16) ; SUBROUTINE MVBEAM(R,I,JY,L,W)
ADD 2,@1(16) ; +I
MOVE 3,2 ;C L AND JY ARE FOR MOVES TO DIFF. STAFF.
ADD 2,@2(16) ; +JY DIMENSION R(1)
MOVE 2,-1(2) ; Y=R(JY+I)
; Z=ABS(Y)
; IF(Z.LT.100.)GO TO 1
; IF(I.GT.5)GO TO 1
;C NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
; Y=AMOD(Y,100.)
; Z=Z-ABS(Y)+ABS(X)
; IF(X)Z=-Z
; GO TO 2
FADR 2,@4(16) ;1 Z=Y+W
ADD 3,@3(16) ; +L
MOVEM 2,-1(3) ; PUT IT IN R(L+I)
JRA 16,5(16) ; END
MVBX: 0 ; SUBROUTINE MVBX(I)
; COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
HRRZI 1,XRN ; LOC OF XRN
ADD 1,@(16) ; EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
MOVE 2,1
ADD 2,KJY+1 ; R(L+I)=R8+(R(JY+I)-R4)*RDIS
MOVE 3,-1(2)
FSBR 3,.COMM.+5
FMPR 3,.COMM.+=25 ; *RDIS
FADR 3,.COMM.+=9 ; +R8
ADD 1,.COMM.+=24 ; + L
MOVEM 3,-1(1)
JRA 16,1(16)
JUGGLE: 0 ; SUBROUTINE JUGGLE
; IMPLICIT INTEGER(A-Z)
; REAL PWDS,RN
; COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
; COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
SOS LIMIT+1 ;ITEM=ITEM-1
HRRZI 15,XRN ; JX=RN(MEDIT)+3 WD CNT OF OLD ITEM
ADD 15,DPY+=4000 ;C I-IX IS WD CNT OF NEW ITEM
KIFIX 14,-1(15) ;MOVE 14,-1(15)
ADDI 14,3 ; JX
MOVE 13,LIMIT+4 ;JY=IX
MOVE 11,LIMIT+3 ; I
SUB 11,13
SUB 11,14 ;Z=I-IX-JX SPACE CHANGE
JUMPL 11,J2751 ;IF(Z)2751,172,751
JUMPE 11,J172
MOVE 5,LIMIT+3 ;751 CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
SUBI 5,1
MOVE 10,DPY+=4000
ADD 10,14
JSA 16,LOOP
JUMP 5
JUMP 10
JUMP [-1]
JUMP 11
JUMP [0]
JUMP XRN
ADD 13,11 ;JY=IX+Z
JRST J172 ;GO TO 172
J2751: ADD 14,DPY+=4000 ;2751 CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
ADD 14,11
MOVE 5,11
ADD 5,LIMIT+4
SOJ 5,
MOVN 10,11
JSA 16,LOOP
JUMP 14
JUMP 5
JUMP [1]
JUMP [0]
JUMP 10
JUMP XRN
;172 J=RN(JY)+2
J172: KIFIX 12,XRN-1(13) ;MOVE 12,XRN-1(13)
ADDI 12,2 ; J IS IN 12
JSA 16,LOOP ;CALL LOOP(0,J,1,MEDIT,JY,RN)
JUMP [0]
JUMP 12
JUMP [1]
JUMP DPY+=4000 ; MEDIT
JUMP 13 ; JY
JUMP XRN
MOVE 12,LIMIT+4 ; I=IX+Z
ADD 12,11 ; Z IS IN 11
MOVEM 12,LIMIT+3
MOVE 12,LIMIT+1 ; 1751 X=ITEM+1
AOJ 12, ; X IS IN 12
HRRZI 13,DPTR ; JX=WDS(X22+1)-WDS(X22)
ADD 13,DL
MOVE 14,(13) ; WDS(X22+1) IN 14 ADR. WDS(X22) IN 13
SUB 14,-1(13) ;JX IN 14
HRRZI 10,DPTR ; J=WDS(X+1)-WDS(X)
ADDI 10,(12)
MOVE 7,(10) ;WDS(X+1)
SUB 7,-1(10) ;J IN 7
MOVEM 7,MVBX ; STORE J
SUB 7,14 ; Y=J-JX
MOVE 14,-1(10) ; JX=WDS(X)+Y+1
ADD 14,7
AOJ 14, ; JX IN 14
JUMPL 7,J2851 ; IF(Y)2851,182,282
JUMPE 7,J182
MOVE 15,(10) ;282 CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
ADDI 15,2 ; ARG 1
MOVE 6,-1(13) ; ARG 2
JSA 16,LOOP
JUMP 15
JUMP 6
JUMP [-1]
JUMP 7 ; Y
JUMP [0]
JUMP DPY
JRST J182 ; GO TO 182
J2851: MOVE 14,(13) ;2851 CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
ADD 14,7 ;+Y
ADDI 14,1 ; ARG 1
MOVE 5,-1(10) ;WDS(X)
ADD 5,7
ADDI 5,1 ; ARG 2
MOVNM 7,MVBEAM ; -Y IS STORED
JSA 16,LOOP
JUMP 14
JUMP 5
JUMP [1]
JUMP [0]
JUMP MVBEAM
JUMP DPY
MOVE 14,-1(10) ; WDS(X) JX=WDS(X)+1
ADDI 14,1 ; JX IN 14
J182: MOVE 5,-1(13) ;182 CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
ADDI 5,1 ;WDS(X22)+1
JSA 16,LOOP
JUMP [1]
JUMP MVBX
JUMP [1]
JUMP 5
JUMP 14
JUMP DPY
MOVE 2,DL ; DO 183 K=X22+1,X
; 183 WDS(K)=WDS(K)+Y
HRRZI 3,PTR
ADDI 3,(2)
J183: JUMPE 11,J184 ;IF(Z.EQ.0)GO TO 184
ADDM 11,(3) ; PWDS(K)=PWDS(K)+Z
AOJ 3, ;UPDATE PWDS AND WDS
J184: JUMPE 7,J185
ADDM 7,(13)
AOJ 13,
J185: CAIGE 2,(12)
AOJA 2,J183 ;ST(2)=WDS(X)
MOVE 2,DPTR-1(12)
MOVEM 2,DPY+1
SETZM DL ;X22=0
JRA 16,(16)
SORT2: 0 ;SUBROUTINE SORT2(RPOS,M)
MOVEI 2,2 ;DIMENSION RPOS(2,200)
S3: MOVE 6,2 ;(K=L HERE)
SETO 11, ;L=2
HRRZI 3,@(16) ;3 J=-1
MOVE 4,2 ;RX=RPOS(1,L-1)
SUBI 4,1 ;L-1
IMULI 4,2
ADDI 4,(3)
MOVE 5,-2(4) ;RX
S2: MOVE 7,6 ; DO 2 K=L,M
;IF(RPOS(1,K).GE.RX)GO TO 2
IMULI 7,2 ;IF(RPOS(1,K).GE.RX)GO TO 2
ADDI 7,(3)
CAMG 5,-2(7)
JRST S1 ; CONTINUE
MOVE 5,-2(7) ; RX=RPOS(1,K);;WHY WERE ALL THE RX'S JX ????? 9/6/73
MOVE 11,6 ;J=K
S1: CAMGE 6,@1(16) ;2 CONTINUE
AOJA 6,S2
JUMPL 11,S4 ;IF(J)GO TO 4
MOVE 12,2 ;K=L-1
SOS 12
IMULI 12,2 ;(K*2)
ADD 12,3 ;CALL EXCH(RPOS(1,K),RPOS(1,J))
MOVE 10,-2(12)
IMULI 11,2
ADD 11,3
EXCH 10,-2(11)
MOVEM 10,-2(12)
MOVE 10,-1(12) ;CALL EXCH(RPOS(2,K),RPOS(2,J))
EXCH 10,-1(11)
MOVEM 10,-1(12)
S4: CAMGE 2,@1(16) ;4 L=L+1
AOJA 2,S3 ;IF(L.LE.M)GO TO 3
JRA 16,2(16) ;END
XNOTE: 0 ;FUNCTION XNOTE(J)
MOVE 3,@(16) ;COMMON/XRN/RN(4000)
IMULI 3,12 ;DIMENSION R(10,80)
;EQUIVALENCE (R,RN(3001))
;XNOTE=AMOD(R(4,J),100.)
MOVE 2,RINP-7(3)
JSA 16,AMOD
JUMP 2
JUMP [=100.0]
CAML [80.0] ;IF(XNOTE.GE.80)XNOTE=XNOTE-100
FSBR [100.0] ; FOR NEG. MINIS, ETC.
MOVE 2,RINP-1(3) ;GET R(10,J)
JUMPE 2,XJRA ;RETURN IF 0
;; MOVE 3,[5.0] ; ON STF ABOVE, +5 HGT.
;; CAMN 2,[1.0] ; 1=STF BELOW
;; MOVNS 3 ; MAKE IT -5
;; FADR 3 ;ADD IT TO XNOTE
KIFIX 3,SCM+=80
MOVE 4,STF(3) ;RSTFAC(STAFF)
ADDI 3,POSI ;X=(THAT STAFF-THIS STAFF)/7.0
MOVE 1,(3) ;THIS STAFF POS.
AOJ 3, ;LOOK AT UPPER STAFF?
CAMN 2,[1.0]
SUBI 3,2 ;NO, LOOK AT LOWER
FSBR 1,(3) ;MINUS THAT STAFF POS.
;X FADR 1,[123.0] ;+ BASIC DIFF. IN STAFF POS.
;X FMPR 1,STF+=8 ;* RSTJ2
;X FSBR 1,[123.0]
FDVR 1,4 ;--OR-- XNOTE=(THIS-THAT)/(-7*RSTFAC(STAFF)
FDVR 1,[-7.0] ; /-7.
FADR 0,1
XJRA: JRA 16,1(16) ;END
BAUTO: 0 ; SUBROUTINE BAUTO(J,L,K,N)
;C FOR AUTOMATIC BEAMS.
MOVEI 2,2 ;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
ADDB 2,@(16) ;J=J+2
MOVE 4,@1(16)
SUB 4,@3(16) ;L-N
MOVE 5,@2(16)
SUB 5,@3(16) ;K-N
FLTR 4,4 ;TLC 4,232000
MOVEM 4,SC+16(2) ;VX(J-1)=L-N
;**** A LIMIT OF 25 BEAMS PER LINE.
FLTR 5,5 ;TLC 5,232000
MOVEM 5,SC+17(2) ;VX(J)=K-N
JRA 16,4(16)
UPDATE: 0 ; SUBROUTINE UPDATE(I)
;COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
MOVE 3,LIMIT+3 ;RN(IS)=I
FLTR 2,@(16) ;MOVE 2,@(16)
MOVEM 2,XRN-1(3)
;IS=IS+I+3
MOVE 2,@(16)
ADDI 2,3
ADDM 2,LIMIT+3
JRA 16,1(16)
IK: 0 ;***** DON'T USE THESE ELSEWHERE, THEY STORE NUMBS.!!
JIT: 0 ; THESE ARE TO STORE PNTRS IN LOOP
NEWR: 0 ; SUBROUTINE R
MOVE A,SC+=70 ;GET THE MODE # ;COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
CAIE A,1 ;COMMON/XRN/RN(4000)
JRST N1 ;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
MOVE JK,LIMIT+3 ;COMMON/SCX/JALPHA(30),JX,U,JZ,IRHY,J4,KA,KB,IZ
MOVEM JK,IK ;1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
MOVE JT,LIMIT+1 ;1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
MOVEM JT,JIT ;DIMENSION R(10,80)
N1: MOVE IS,IK ;EQUIVALENCE (R,RN(3001))
MOVEM IS,LIMIT+3
MOVE 14,[9999.0]
MOVE JT,JIT ;IF(MODE.NE.1)GO TO 1
ADDI JT,1 ;IK=IS
MOVEM JT,LIMIT+1 ;HOMER=ITEM
MOVEI K,=10 ;1 IS=IK
MOVE IZ,SCX+=37 ;ITEM=HOMER+1 ******************** WAS +=33
IMULI IZ,=10 ;MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
;***N2: CAMN 14,RINP-3(K) ;IF(R(8,K).EQ.9999.)GO TO 2
;**** JRST NN2 ;SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
N2: SETO IEND, ;C JUMP FOR BEAM CONT.
;IEND=-1
MOVE A,SC+=70 ;PUT MODE NUM. INTO A
MOVE IS,RINP-=10(K) ;GET CODE NUM. FROM R(1,K)
CAMN IS,[1.0] ;IF IT IS 1, IEND=0
JRST NX1 ;IF(MODE.NE.2)GO TO NX2
CAMN IS,[2.0] ;IF(CODE IS NOT 2)GO TO NX2
;; CAME IS,[2.0] ;IF(CODE IS NOT 2)GO TO NX2
;; JRST NX2
SKIPL RINP-5(K) ;IF(R(6,K).GE.0)GO TO NX2
JRST NX2
SKIPN RINP-4(K) ;IF(R(7,K).EQ.0)GO TO NN2 (DELETE IF INVIS. REST
JRST NN2 ; AND NO RHYTHMIC VALUE.)
SKIPA
NX1: SETZ IEND,
NX2: MOVE L,LIMIT+3 ;RN(IS+3)=0
SETZM XRN+2(L) ;RN(IS+2)=0
SETZM XRN+1(L)
;; SETZM LOOP ;LOOP=0 FOR P2→P11 TRANSFER
MOVEI L,=10 ;C ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
CAIL A,4 ;LK=10 IF(MODE.GT.3)L=7
MOVEI L,8 ;ONLY LOOK AT 8 PARAMS AFTER MODE 3.
N3: HRRZI R,RINP(K) ;DO 3 L=LK,1,-1
ADDI R,(L) ;A=R(L,K)
MOVE A,-13(R) ;(OCTAL) =13
JUMPGE IEND,NX4 ;IF(A.NE.0)GO TO 77
JUMPE A,NN3 ;IF(IEND)GO TO 3
;; JUMPN A,NX3 ;IF(IEND)GO TO 3
;; JRST NN3
NX3: MOVE IEND,L ;77 IF(IEND)IEND=L
NX4: MOVE R,LIMIT+3
ADDI R,(L)
MOVEM A,XRN-1(R) ;RN(IS+L)=A
NN3: CAILE L,1 ;3 CONTINUE
SOJA L,N3
MOVE A,SCM+=80 ;A=STAFF #
MOVEM A,XRN(R) ;PUT IT IN P2
CAME IS,[1.0] ;IF NOT CODE 1, SKIP OVER
JRST N4
MOVEI IEND,=11 ;SET WDCNT
MOVE A, RINP-9(K) ;GET WHAT'S IN R(2,K)
MOVEM A,XRN+=9(R) ;PUT IT IN P11
N4: CAIGE IEND,3 ;IF(LOOP.NE.0)RN(IS+11)=LOOP (REAL)
MOVEI IEND,3
MOVE 15,IEND ;IF(IEND.LT.3)IEND=3
SUBI 15,2
MOVE SC+=70 ;IF(A NOTE AND MODE.EQ.3)R(9,K)=PTR TO P11 OF NT.
CAMN IS,[1.0]
CAIE 3
JRST NN4
MOVE 0,R
ADDI =10
FLTR 0 ;USE THIS IN SLUR ROUTINE
MOVEM RINP-2(K) ;R(9,K)
NN4: JSA 16,UPDATE ;CALL UPDATE(IEND-2)
JUMP 15
NN2: CAML K,IZ ;2 CONTINUE
JRA 16,(16) ;END
ADDI K,=10
JRST N2
RNX: 0 ;CALL RNX(A,B,C,D,E,F,G,H,I)
MOVE 1,LIMIT+3 ;FILLS PARAMS 0→8 RN(IS+0)...RN(IS+8)
MOVE @(16)
MOVEM XRN-1(1) ;CALLED FROM 'BEAMS'
MOVE @1(16)
MOVEM XRN(1)
MOVE @2(16)
MOVEM XRN+1(1)
MOVE @3(16)
MOVEM XRN+2(1)
MOVE @4(16)
MOVEM XRN+3(1)
MOVE @5(16)
MOVEM XRN+4(1)
MOVE @6(16)
MOVEM XRN+5(1)
MOVE @7(16)
MOVEM XRN+6(1)
MOVE @10(16)
MOVEM XRN+7(1)
JRA 16,11(16)
CNT: 0
MSSLUP: 0
SETZ 1, ;161 CNT=1
SETZ 2,
L5543: MOVE 3,.COMM.+4(2) ;DO 5543 K=1,10
;RA=RJQ(K)
SKIPE 3 ;IF(RA.NE.0)CNT=K
MOVE 1,2 ;5543 RJJ(K)=RA
MOVEM 3,RRJJ+1(2)
CAIG 2,=8 ; LOOP BACK?
AOJA 2,L5543
AOJ 1, ;********* WILL SAVE UP TO PARAM 12 ONLY!
MOVEM 1,CNT ;REMEMBERS CNT
JRA 16,(16)
LUP2: 0 ;261 RN(I)=CNT
FLTR 2,CNT ;MOVE 2,CNT
MOVE 1,LIMIT+3
MOVEM 2,XRN-1(1)
FLTR 2,.COMM.+1 ;MOVE 2,.COMM.+1 ;RN(I+1)=JA
;I=I+2
MOVEM 2,XRN(1)
MOVE 3,.COMM. ;RN(I)=R2
MOVEM 3,XRN+1(1)
MOVE 5,CNT ;DO 4554 K=1,CNT
ADD 1,CNT
ADDI 1,3
MOVEM 1,LIMIT+3
L4554: MOVE 2,.COMM.+3(5)
MOVEM 2,XRN-2(1) ;4554 RN(I+K)=RJQ(K)
SOJ 1,
SOJG 5,L4554 ;3554 I=I+CNT+1
JRA 16,(16)
;;C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
;; SUBROUTINE HOMER
;; IMPLICIT INTEGER(A-Q,S-Z)
;; REAL PWDS,DISX,A,B,PLACE,STFF
;; COMMON /STF/RSTFAC(-3/4),RSTJ2
;; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
;; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
;; COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
;; EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(J11,JQ(9)),(RD,RN(4000))
;; 1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
;; 1,(J10,JQ(8)),(R8,RJQ(6)),(J7,JQ(5))
HOMER: 0 ; IF(JA.EQ.6)GO TO 9
MOVE MM,.COMM.+1
CAIN MM,6
JRST H9
SKIPE .COMM.+=14 ;IF(R13.NE.0)GO TO 10
JRST H10 ; FOR GENL HOMING; WORDS; BEAMS; STEMS;
; ALF+=14= IS = WIDTH OF NOTE -- NEEDED BECAUSE OF DIFF. STEM DIRECTIONS.
; NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
JSA 16,HOMX
JRA 16,(16)
H9: SKIPGE .COMM.+=32 ;9 IF(J11.LT.0)RETURN
JRA 16,(16) ; IF P11=-1 NO HOMING
MOVM R,.COMM.+=28 ; X=IABS(J7)/10 CC X=R7/10.
IDIVI R,=10 ;;;FDVR R,[=10.0]
SKIPN 2,.COMM.+=31 ;IF(J10.EQ.0)GO TO H100
JRST H100
CAIL 2,=10 ;IF(J10.GE.10)X=0 (=LOOK AT ALL STEM DIRS.)
SETZ R,
H100: MOVEM R,XNOTE ;X SAVED IN XNOTE = STEM DIR. OF BEAM.
; R9= POS3
;XXX MOVNI RC,1 ;RC=-1
;XXX SKIPE .COMM.+=10 ;IF(R9.NE.0)RC=-2 ****OR .GT. *******
;XXX MOVNI RC,2
;??? MOVE .COMM.+=11 ;GET P10
;??? JUMPE H10 ;IGNORE IF 0
;CCC SKIPLE .COMM.+=8 ; SKIP IF R7 IS .LE.0
;CCC MOVNI RC,3 ; RC=0 ESCAPES FRCOM LOOP.
; HOMING RANGE FOR BEAMS
H10: SKIPN NX,.COMM.+=12 ; 10 IF(R11.EQ.0)R11=2.9
MOVE NX,[=2.9]
MOVEM NX,.COMM.+=12 ; IF P11.NE.0 RANGE IS CHANGED FROM 2
SETZ IZ,
;XXHX10: MOVE IZ,.COMM.+1 ; IF(JA.EQ.5)RC=-1
HX10: MOVEI K,1
SETZ RC,
MOVE L,.COMM.+1 ; JA IS NOW IN L
;; CAIN L,5
SUBI L,5 ;NOW JA=5 IS L=0
SKIPN L
SETO RC,
H361: JSA 16,FINDIT ;DO 361 K=1,ITEM
JUMP K
JUMPL 0,HX361 ;IF(FINDIT(K))GO TO 361
; SKIPS NOTES ON WRONG LINE
MOVEI R,XRN ;RD=RN(L+3)
ADD R,LIMIT+2 ;LOC OF RN(L+1)
MOVE A,2(R) ;RD IN A
MOVEM A,RMOD+=9 ;1 IF(JA.NE.6)GO TO 177
KIFIX JK,4(R) ;IF(IFIX(RN(L+5)/10).NE.X)GO TO 361
IDIVI JK,=10 ;JK=NOTE'S STEM DIRECTION
CAIE L,1 ;L=1 = JA=6
;; CAIE L,6
JRST H177
JUMPE JK,HX361 ;IF(RN(L+5).LT.10)GO TO HX361 (NO STEM)
SKIPN XNOTE ;IF(XNOTE.EQ.0)GO TO H177
JRST H177 ;XNOTE=0 = CHECK ALL STEM DIRS.
CAMN JK,XNOTE ;ARE STEM DIR,S SAME?
JRST H377 ;YES, JUMP
MOVE -1(R)
CAML [8.0]
SKIPN JT, =9(R) ;JT='OTHER STAFF' INFO 2=↑ 1=↓
SKIPA
JRST HH377 ;IF(RN(L+10).EQ.0)GO TO H377
MOVE .COMM.+5 ;LEFT HEIGHT OF BEAM
FADR .COMM.+6 ;RIGHT HEIGHT
FDVR [2.0] ;AVERAGE HEIGHT OF BEAM
FSBR 3(R) ;SUBTR HEIGHT OF NOTE
CAIE JK,1 ;IF NOTE STEM DOWN, REVERSE SIGN
MOVNS
CAMG [8.0] ; IF DIFF. IS LESS THAN 8 DON'T HOOK BEAM TO STEM.
JRST H377
;; SKIPN XNOTE ;IF(XNOTE.EQ.0)GO TO H177
;; JRST H377 ;IF(RN(L+10).EQ.0)GO TO H377
HH377: MOVE 1,RNW ;RNW IS NOTE WIDTH( CURRENTLY =2.44)
FMPR 1,STF+=8 ;*RSTJ2
MOVM NN,.COMM.+=25 ;IF(ABS(J4.GE.100) *.6 (MINI)
CAIL NN,=90
FMPR 1,[0.6]
CAIE JK,1
MOVNS 1
FADR A,1 ; ADD OR SUB. NOTE WIDTH FROM NOTE POS.
JRST H177 ;ALL NOTES ON 'DIFF. STF' ARE CONSIDERED.
H377: CAME JK,XNOTE
JRST HX361
H177: JSA 16,PLACE ;177 IF(PLACE(R3))GO TO 461
JUMP .COMM.+4
JUMPG HXX
JUMPN L,H461 ; DO NEXT IF HOMING SLUR
;; CAIE L,5 ; DO NEXT IF HOMING SLUR
;; JRST H461
JSA 16,PLACE ;ALSO CHECK FOR P6 (RT. END OF SLUR)
JUMP .COMM.+7
JUMPL H461 ; IF NEG. = DIDN'T FIND IN THAT AREA
MOVEI .COMM.+7 ; GET LOC. OF P6
SKIPA
HXX: MOVEI .COMM.+4 ;LOC. OF P3
MOVEM NX ;SAVE LOC. OF EITHER P3 OR P6
SETO IZ,
HX2: MOVE 5(R) ;GET PARAM 6
CAMGE [10.0] ; MUST BE .GE.10
JRST HX1
MOVE IS,RNW ; SIZE OF A NOTE (NOW =2.44)
CAML [20.0] ; 10 = RIGHT SHIFT, 20 = LEFT SHIFT
MOVNS IS
MOVM 3(R) ; GET P4
CAML [80.0] ; IS IT A MINI?
CAML [180.0]
SKIPA
FMPR IS,[0.6] ;*RMINI
MOVE 1,.COMM.+3 ;STAFF #
FMPR IS,STF(1) ;*RSTFAC(J2)
FADR A,IS
HX1: JUMPG IZ,HX8 ; JUMP TO CHANGE P6, 8 OR 9
HX3: MOVEM A,(NX) ;R3=RD (OR R6)
;;HX3: MOVEM A,.COMM.+4 ;R3=RD
; LOOKS FOR NOTE, STAFF #, STEM DIR.
MOVN .COMM.+=14 ;P13=-1 HOME TO NOTE SIDE, =-2 TO STEM.
SKIPG ;IS IT NEG.
JRST H11 ; NO, GO TO NEXT SECTION.
MOVEI JT,.COMM.+4 ;GET LOC. OF R3
MOVE IS,3(R) ; VERTICAL POS OF NOTE (P4)
CAME [1.0] ;IS P13 -1 OR -2?
JRST H12 ;IT'S -2
MOVE [2.0]
;; CAIE JK,2 ;WHICH WAY IS STEM? 2=STEM DOWN
SKIPG .COMM.+=8 ;JUMP IF SLUR CURVES UP (STEMS DOWN) IN P7
MOVNS ;ELSE MAKE DISPLACEMENT NEG.
FADR IS ;ADD NOTE LEVEL
;; MOVEM .COMM.+5 ;P4=NOTE LEVEL + OR - 2.
JRST HZ
H12: MOVE IZ,7(R) ; STEM LENGTH
CAMN IZ,[999.0] ; WHAT ABOUT 16TH AND 32ND NOTES??
SETZ IZ,
FADR IZ,[8.0]
JSA 16,AMOD
JUMP 6(R)
JUMP [10.0] ;AC0=AMOD(R7,10.0)
;; SKIPN
;; JRST H13
JUMPE H13
FSBR [1.0] ;IGNORE 1ST TAIL
FMPR [1.8] ; *SPACE FOR EACH TAIL
H13: FADR IZ ; ADD TO STEM LENGTH
CAIL JK,2 ; <2 = STEM UP
MOVNS ;PUT IT UPSIDE DOWN.
FADR IS ;ADD NOTE LEVEL
;; MOVEM IS,.COMM.+5 ;PUT IT BEYOND STEM
HZ: CAME JT, NX ;ARE WE LOOKING AT R3 OR R6 (JT=R3)
JRST .+3 ;JUMP FOR R6
MOVEM .COMM.+5 ;PUT VERT. POS. INTO R4
SKIPA
MOVEM .COMM.+6 ;PUT VERT. POS. INTO R5
;;H11: CAIN L,6 ;IF(JA.EQ.6)GO TO 861
;; JRST H861
;; CAIN L,5 ;IF(JA.EQ.5)GO TO 261
;; JRST HX361
H11: CAIN L,1 ;IF(JA.EQ.6)GO TO 861
JRST H861
JUMPE L,HX361 ;IF(JA.EQ.5)GO TO 261
JRA 16,(16) ;RETURN
;;H461: CAIN L,6 ;461 IF(JA.EQ.6)GO TO 277
;; JRST H277
;; CAIE L,5 ;IF(JA.NE.5)GO TO 361
;; JRST HX361
H461: CAIE L,1 ;461 IF(JA.EQ.6)GO TO 277
JUMPN L,HX361 ;IF(JA.NE.5)GO TO 361
H277: JSA 16,PLACE ;277 IF(PLACE(R6))GO TO 561
JUMP .COMM.+7
JUMPL H561
MOVEI IZ,7 ;R6=RD
JRST HX2
H861: MOVE 0,.COMM.+=28 ;861 IF(J7.GE.0)GO TO 261
JUMPGE 0,HX361
H561: MOVE .COMM.+=10 ;IF(R9.LE.0)GO TO 661
JUMPLE H661
JSA 16,PLACE ;561 IF(PLACE(R9))GO TO 661
JUMP .COMM.+=10 ;R9
JUMPL H661
SKIPL .COMM.+=28 ;IF(J7)GO TO 761 J7=NEG MEANS TREMOLO
SKIPE .COMM.+=9 ; IF(R8.NE.0)GO TO 761
JRST H761
;; MOVE 0,.COMM.+=28 ;IF(J7)GO TO 761
;; JUMPL H761 ; J7=NEG MEANS TREMOLO
;; MOVE 0,.COMM.+=9 ; IF(R8.NE.0)GO TO 761
;; JUMPN H761
MOVE 0,.COMM.+=11 ; IF(R10.EQ.0)GO TO 361
JUMPE HX361
H761: MOVEI IZ,=10 ;761 R9=RD
JRST HX2
; R8=0, R10=0 MEANS R9 IS NUMBER OUTSIDE OF BEAM. ; GO TO 261
;;H661: CAIN L,5 ;661 IF(JA.EQ.5)GO TO 361
;; JRST HX361
H661: JUMPE L,HX361 ;661 IF(JA.EQ.5)GO TO 361 L=1 = JA=5
;; MOVE 0,.COMM.+=31 ;IF(J10.LT.30)GO TO 361
;; CAIGE 0,=30
SKIPN .COMM.+=31 ;IF J10.EQ.0 GO TO 361
JRST HX361
JSA 16,PLACE ;IF(PLACE(R8))GO TO 361
JUMP .COMM.+=9
JUMPL HX361 ; HOMES INNER PARTIAL BEAMS
MOVEI IZ,=9 ;R8=RD
JRST HX2
HX8: MOVEM A,.COMM.(IZ) ;PUT A INTO RIGHT PARAM.
;XXXH261: SKIPN RC ;261 IF(RC.EQ.0)RETURN
;XXX AOJ RC ;RC=RC+1
HX361: CAMGE K,LIMIT+1 ;361 CONTINUE
AOJA K,H361
JRA 16,(16) ; END
;;PFIBX: 0 ;DATA FIB/0.618/, RFIB/-.382/,ALG/0.6931472/
;100 ACCEPT 10,A 10 FORMAT(F)
;; MOVE 12,@(16) ;PFIBX=14
;; MOVE 13,[14.0] ;IF(A.EQ.1)GO TO 20
;; CAMN 12,[1.0] ;Z=FIB
;; JRST PFX ;IF(A.LT.1)Z=RFIB
;; JSA 16,ALOG ;RH=ABS(ALOG(A)/ALOG(2.0))
;; JUMP 12
;; FDVR 0,[0.6931472] ;ALOG(2.0)
;; MOVM 11,0
;; MOVE 10,[0.618] ;FIB FACTOR
;; SKIPG ;L=RH
;; MOVN 10,[0.382] ;IF(L.EQ.0)GO TO 4
;; KIFIX 7,11
;; MOVE 6,7 ;SAVE L FOR LATER
;; JUMPE 6,PFZ
;;PF: MOVE 2,13 ; DO 3 K=1,L
;; FMPR 2,10 ;3 PFIBX=PFIBX+PFIBX*Z
;; FADR 13,2
;; SOJG 6,PF
;;PFZ: FLTR 7,7 ;4 RH=RH-L
;; FSBR 11,7 ;IF(RH.EQ.0)GO TO 20
;; JUMPE 11,PFX
;; MOVE 2,13
;; FMPR 2,10
;; FMPR 2,11 ;PFIBX=PFIBX+PFIBX*Z*RH
;; FADR 13,2
;;PFX: MOVE 0,13 ;SEND BACK THE RESULT
;; JRA 16,1(16)
CODN: 0 ;FUNCTION CODN(K,N)
MOVE 1,@(16) ;GET CODE NUMBER AND RETURN POINTER
MOVE 2,PTR-1(1) ;L=KWDS(K)
MOVEM 2,@1(16)
MOVE XRN(2) ;CODN=RN(L+1)
JRA 16,2(16)
FSCAN: 0
INCHRW
MOVE 2,[ASCII/ /]
MOVEM 2,ALF
MOVE 2,[XWD ALF,ALF+1]
BLT 2,ALF+=71 ; CLEANS OUT INP ARRAY
CAIN ";"
JRA 16,(16)
CAIN ":"
JRA 16,1(16)
CAIN "("
JRA 16,2(16)
CAIN ")"
JRA 16,3(16)
CAIN "/"
JRA 16,4(16)
CAIN "*"
JRA 16,5(16)
CAIN "X"
JRA 16,6(16)
CAIN "C"
JRA 16,7(16)
JRA 16,8(16)
NALF: 0
MOVE 0,@(16)
JUMPGE .+4 ;IF(I.GE.0)GO TO 20
MOVE 1,[405004020100] ; J='A'=405004020100
SETO 2, ; M=-1
JRST .+3 ;GO TO 10
MOVE 1,[201004020100] ;20 J=' '=201004020100
MOVEI 2,=16 ; M=16
SUB 0,1 ;10 NALF=(I-J)/536870912-M
IDIV 0,[3777777777]
SUB 0,2
JRA 16,1(16)
BOX: 0 ;CALL BOX(I,R) SEE PLTSRT.F4 FOR FORTR. VERSION
MOVE IDEV
CAIE 5
JRA 16,2(16) ;IF(IDEV.NE.5)RETURN
MOVE 14,@(16) ; I IS IN 14
JUMPL 14,BX4
KIFIX 13,@1(16) ;K=R ;MOVE 13,@1(16) ; GET R
JSA 16,AMOD
JUMP XRN+3(14) ; GET REAL P4
[100.0]
CAMGE [-20.0] ;IF(P4.LT.-20)P4=P4+100
FADR [100.0] ; FOR P4=-95 ETC.
CAML [80.0] ;IF(P4.GE.80)P4=P4-100
FSBR [100.0] ; CATCHES NEG. MINIS, ETC.
FMPR [7.0]
FMPR STF(13) ;*STAFF FACTOR
FADR POSI(13) ; + STAFF VERT. POS.
FSBR [40.0] ; SHIFT CURSOR DOWN A BIT.
FMPR SIZ
KIFIX 13,0
SUB 13,SIZ+2 ;13=K
JSA 16,RHORZ ; GET HORIZ. POS.
JUMP XRN+2(14)
FMPR SIZ ;SIZ IS FOR ZOOMED IMAGES
KIFIX 12,0 ;MOVE 12, ; 12=L
SUB 12,SIZ+1
CAIL 12,=550 ; CHECK IF OUT OF BOUNDS OF CRT
MOVEI 12,=511
CAMG 12,[-=550]
MOVE 12,[-=511]
JSA 16,SETCUR
12
13
[0]
MOVE DL ;IOLD=X22 FOR TYPING "I <CR>" TO GET LAST EDIT BACK.
MOVEM DL+4
JRA 16,2(16) ; THE CURSOR IS IN POSITION
BX4: CAME 14,[-1]
JRST BX5
JSA 16,DPYSET
[3]
RINP
[=100]
JSA 16,DPYBRT
[3]
BX5: MOVE 2,@1(16) ; GET R
JSA 16,RHORZ
2
FMPR SIZ
KIFIX 0,0
SUB SIZ+1
MOVM 2,
CAILE 2,=550
JRST BX6
MOVEM 0,LOOP
JSA 16,SETPOG
[3]
JSA 16,ALINE
LOOP
[-=511]
LOOP
[=511]
JSA 16,DPYOUT
[3]
BX6: JSA 16,SETPOG
[1]
JRA 16,2(16)
PARCH: 0 ;CALL PARCH(JA,JJA,RD)
MOVE 2,@(16) ;GET JA
CAIN 2,2 ;IS IT P2
JRST .+8
CAIE 2,1 ;IS IT P1
JRA 16,3(16) ;NEITHER
KIFIX 3,@2(16) ;GET RD
JUMPE 3,.+3 ; REJECTS CODE # 0.
CAIG 3,=18 ;IS PARAM .GT.18?
MOVEM 3,@1(16) ;PUT IT INTO JJA
JRA 16,3(16) ;ALL DONE
MOVE 3,@2(16) ;GET RD
CAMG 3,[7.0] ;REJECTS STAFF # .GT.7
MOVEM 3,RRJJ ; PUT IT AWAY
JRA 16,3(16)
RCURVE: 0 ; R7=RCURVE(R3)
MOVE 2,(16) ; R7=0.9+(R6-R3)/25.+ABS(R4-R5)/10.
MOVE 1,3(2)
FSBR 1,(2) ;R6-R3
MOVE 3,5(2) ;IF(R8.LT.-1)Z=Z+R8*2.
FADR 3,[1.0]
JUMPGE 3,RCRV ;R8=-2=BETWEEN NOTES, =-3=1ST NOTE IS DOTTED.
FADR 3,3
FADR 1,3
RCRV: FDVR 1,[25.0] ; /25.
MOVE 0,2(2)
FSBR 0,1(2) ;R5-R4
MOVMS ;ABSOLUTE VALUE
FDVR 0,[10.0] ; /10.
FADR 0,1
FADR 0,[0.9] ; +.9
SKIPGE 4(2) ;IF(R7 WAS .LT.0)KEEP IT NEGATIVE.
MOVNS
JRA 16,1(16)
RJED: 0 ;6222 DO 1222 K=1,20,2
MOVEI 1,1
RJ1: SKIPN .COMM.+=23(1)
JRA 16,(16)
MOVE 4,.COMM.+=23(1) ;L=JQ(K)
;IF(L.EQ.0)GO TO 6221
; '600 2' WILL ADD 2 TO PARAM 6. '3000 6' SETS P3=P6.
MOVE 5,.COMM.+4(1) ;RD=RJQ(K+1)
MOVE 6,4 ;X=L
CAIGE 4,=100 ;IF(L.LT.100)GO TO 223
JRST RJ223
CAIGE 4,=2000 ;IF(L.LT.2000)GO TO 5223
JRST RJ5223
IDIVI 6,=1000 ;X=L/1000
MOVE 4,.COMM.+=24(1) ;L=JQ(K+1)-2
SUBI 4,2
MOVE 5,RRJJ(4) ;RD=RJJ(L)
JRST RJ2223 ;GO TO 2223
RJ5223: IDIVI 6,=100 ;5223 X=L/100
CAIN 6,2 ;IF(X.EQ.2)GO TO 1223
JRST RJ1223
FADR 5,RRJJ-2(6) ;RD=RJJ(X-2)+RD
JRST RJ2223 ;GO TO 2223
RJ1223: FADR 5,RRJJ ;1223 RD=RJJ2+RD
RJ223: CAIG 6,2 ;223 IF(X.LE.2)GO TO 3223
JRST RJ3223
RJ2223: MOVEM 5,RRJJ-2(6) ;2223 RJJ(X-2)=RD
JRST RJ1222 ;GO TO 1222
RJ3223: JSA 16,PARCH ;3223 CALL PARCH(X,JJA,RD)
6 ; NOW P1 CAN BE CHANGED IN EDIT MODE -- BE CAREFUL,,,,!!!!!!
RRJJ+21
5
RJ1222: ADDI 1,2
CAIG 1,=20 ;1222 CONTINUE
JRST RJ1 ;*** LOOP SET TO 20(20 IN ARRAY!) ONLY 13 PARAMS POSSIBLE NOW.
JRA 16,(16)
RJED2: 0
MOVEI 1,=11 ;6221 DO 5514 K=1,11
RJ6221: MOVE 3,RRJJ(1) ;R2=RJJ(K)
MOVEM 3,.COMM.+3(1) ;RJQ(K)=R2
KIFIX 3,3
MOVEM 3,.COMM.+=23(1) ;5514 JQ(K)=R2
SOJG 1,RJ6221
MOVE RRJJ ;R2=RJJ2
MOVEM .COMM.
MOVE RRJJ+=21 ;JA=JJA
MOVEM .COMM.+1
SOS LIMIT+1 ;ITEM=ITEM-1
SKIPGE LIMIT+1 ;IF(ITEM)ITEM=0
SETZM LIMIT+1
JRA 16,(16)
EDX: 0 ;FUNCTION EDX(RLINE)
MOVE 2,JCHAR+4 ;AC2=JED
CAMLE 2,LIMIT+1 ;244 X=ITEM
JRST E444 ;IF(JED.GT.X)GO TO 444
MOVE 6,.COMM.+1 ;AC6=JA
MOVE 4,JCHAR+6 ;AC4=REDIT
MOVE 3,JCHAR+5 ;AC3=KED
MOVE 5,JCHAR+7 ;AC5=RITEM
SETZ 7, ;FLAG FOR '33' FEATURE
CAME 5,[33.0] ;IF CODE NUM 33 IS TYPED IT MEANS ALL THINGS
CAMN 5,[44.0] ;USE 44 FOR NON-BARLINES IN CODE 4
SKIPA
JRST EDZ ;UNDER CODE 3 EXCEPT P5=0,1,2,3,4,5 (REAL CLEFS)
SETO 7,
FDVR 5,[11.0] ;CHANGE 33,44 BACK TO 3,4
EDZ: MOVE 1,PTR-1(2) ; DO 144 K=JED,X
CAMN 3,[-2] ;L=PWDS(K)
JRST E654 ;IF(KED.EQ.-2)GO TO 654
; -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
CAIN 3,2 ;IF(KED.EQ.2)GO TO 656
JRST E656
CAME 4,XRN+1(1) ;IF(RN(L+2).NE.REDIT)GO TO 144
JRST E144
JUMPL 3,E654 ;IF(KED)GO TO 654
JUMPE 5,E655 ;IF(RITEM.EQ.0)GO TO 655
E656: CAME 5,XRN(1) ;656 IF(RITEM.NE.RN(L+1))GO TO 144
JRST E144
JUMPE 7,E655 ;SKIP NEXT UNLESS '33,44' FLAG IS SET (AC7=-1)
MOVE XRN-1(1) ;IF(RN(L).EQ.1)GO TO 144 (TREBLE CLEF)
CAMG [2.0]
JRST E144
CAMN 5,[4.0] ;IF(RITEM.EQ.4)GO TO 655
JRST E655 ;JUMP IF WDCNT OF CODE 4 .GT.2
MOVE XRN+4(1) ;IF(RN(L+5).LE.5)GO TO 144 (SOME REAL CLEF)
CAMG [5.0]
JRST E144
E655: CAIE 6,=55 ;655 IF(JA.NE.55)GO TO 344
JRST E344
E654: MOVE @(16) ;654 IF(ABS(RLINE-RN(L+3)).LT.5.0)GO TO 344
FSBR XRN+2(1)
MOVMS
CAMGE [5.0]
JRST E344
E144: CAMGE 2,LIMIT+1 ;144 CONTINUE
AOJA 2,EDZ
E444: MOVE [999.0] ;444 REDIT=999.
MOVEM JCHAR+6 ;C NO MORE ON LINE
SETZM .COMM. ;R2=0
; SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
JRA 16,1(16) ;GO TO 73
E344: MOVEM 2,DL ;344 JED=K+1
AOJ 2, ;C FOR NEXT TIME AROUND
MOVEM 2,JCHAR+4
SETO ;X22=K
JRA 16,1(16) ;AC0=-1=GO TO 429, =>0=GO TO 73
EQUAL: 0 ;CALL EQUAL
MOVE 2,.COMM.+1 ;IF(JA.LE.13)GO TO 324
CAIG 2,=13
JRST EQ324
IDIVI 2,=10 ;JA=JA/10
; ADD 1000 TO PARAM TO MAKE EQUAL TO ANOTHER PARAM
KIFIX 3,.COMM. ; X=R2-2.
MOVE RRJJ-2(3) ;RJJ(JA-2)=RJJ(X)
MOVEM RRJJ-2(2)
JRA 16,1(16) ;GO TO 6222
EQ324: MOVE .COMM. ;GET R2
SKIPGE @(16) ;(X) 324 I1=JA-2
JRST EQ224 ;IF(X)GO TO 224
MOVEM RRJJ-2(2) ;RJJ(I1)=R2
JRA 16,1(16) ;GO TO 6222
EQ224: FADRM RRJJ-2(2) ;224 RJJ(I1)=RJJ(I1)+R2
JRA 16,1(16)
BOXX: 0 ;CALL BOXX
MOVE LIMIT+3 ;429 IX=I
MOVEM LIMIT+4
MOVE 1,DL ; MEDIT=PWDS(X22)
MOVE 1,PTR-1(1)
MOVEM 1,DPY+=4000
;; MOVEI 2,2 ; J=2
KIFIX 3,XRN-1(1) ;;426 Y=RN(MEDIT)+J
ADDI 3,2
MOVEM 3,EQUAL ; EQUAL IS 'Y'
JSA 16,LOOP ; CALL LOOP(0,Y,1,I,MEDIT,RN)
[0]
EQUAL
[1]
LIMIT+3
DPY+=4000
XRN
MOVE 3,LIMIT+3 ; JJA=RN(I+1)
KIFIX 3,XRN(3)
MOVEM 3,RRJJ+=21
MOVE EQUAL ; YED=Y-2
SUBI 2
MOVEM YED
MOVE 1,LIMIT+3 ; L=I+2
ADDI 1,2
MOVE 3,1 ;AC3=K+L-1
MOVEI 2,1 ; AC2 = K
BXX: CAMLE 2,YED ; DO 422 K=1,11
JRST BX423 ; IF(K.GT.YED)GO TO 423
MOVE XRN(3) ; RJJ(K)=RN(L+K)
MOVEM RRJJ(2)
JRST BX422 ; GO TO 422
BX423: SETZM RRJJ(2) ;423 RJJ(K)=0
BX422: AOJ 3, ; UPDATE K+L-1
CAIGE 2,=11 ;422 CONTINUE
AOJA 2,BXX
MOVE XRN-1(1) ; RJJ2=RN(L)
MOVEM RRJJ
SKIPLE DPY+=4001 ; IF(IGO.GT.0)GO TO 4231
JRST BX4231 ; NO BOX WHEN IN GROUP EDIT ROUTINE
MOVEM YED+2 ; RBOX=RJJ2
MOVE LIMIT+3 ; IBOX=I
MOVEM YED+1
JSA 16,BOX ; CALL BOX(IBOX,RBOX)
YED+1
YED+2
BX4231: AOS LIMIT+1 ;4231 ITEM=ITEM+1
MOVE 1,LIMIT+1
MOVE DPTR-1(1) ; ST2=WDS(ITEM)
JRA 16,(16) ; RETURN
END